home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lisp / qprolog-indent.el < prev    next >
Encoding:
Text File  |  1992-05-26  |  15.7 KB  |  595 lines
  1. ;;; @(#)qprolog-indent.el    3.4 12/12/90 
  2. ;;;            Quintus Prolog - GNU Emacs Interface
  3. ;;;                         Support Functions
  4. ;;;
  5. ;;;                Consolidated by Sitaram Muralidhar
  6. ;;;
  7. ;;;                   sitaram@quintus.com
  8. ;;;              Quintus Computer Systems, Inc.
  9. ;;;                  2 May 1989       
  10. ;;;
  11. ;;; This file defines functions that support the Quintus Prolog - GNU Emacs
  12. ;;; interface.
  13. ;;;
  14. ;;;                   Acknowledgements
  15. ;;;
  16. ;;;
  17. ;;; This interface was made possible by contributions from various
  18. ;;; customers of Quintus Computer Systems, Inc., based on code for
  19. ;;; Quintus's Unipress Emacs interface.
  20. ;;; 
  21.  
  22. ;;;
  23. ;;; User Settable variables to control Indentation
  24. ;;;
  25. (defvar head-continuation-indent 6
  26.    "Offset for continuation of clause head arguments.")
  27. (defvar body-predicate-indent 8
  28.    "The column at which the body of a predicate is to begin")
  29. (defvar if-then-else-indent 4
  30.    "Offset within an if-then-else statement")
  31. (defconst prolog-tab-always-indent t
  32.    "*Non-nil means TAB in Prolog mode should always reindent the current line,
  33. regardless of where in the line point is when the TAB command is used.")
  34. (defconst fact-column 0 
  35.    "Column at which facts and single line clauses begin")
  36.  
  37.  
  38. ;; This is used by indent-for-comment
  39. ;; to decide how much to indent a comment in Prolog code
  40. ;; based on its context.
  41. (defun prolog-comment-indent ()
  42.   (cond 
  43.    ((looking-at "%%%") (current-column))
  44.    ((looking-at "%%") (current-column))
  45. ;;    (let ((tem (calculate-prolog-indent)))
  46. ;;      (if (listp tem) (car tem) tem)))
  47.    ((= (following-char) ?%)
  48.     (skip-chars-backward " \t")
  49.     (max (if (bolp) 0 (current-column))
  50.      comment-column))
  51.    ((looking-at "^/\\*") 0)        ;Existing comment at bol stays there.
  52.    (t (save-excursion
  53.     (skip-chars-backward " \t")
  54.     (max (current-column)           ;Else indent at comment column
  55.          comment-column)))))    
  56.  
  57. (defun prolog-inside-parens-p ()
  58.   (condition-case ()
  59.       (save-excursion
  60.     (save-restriction
  61.       (narrow-to-region (point)
  62.                 (progn (beginning-of-clause) 
  63.                    (point)))
  64.       (goto-char (point-max))
  65.       (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
  66.     (error nil)))
  67.  
  68. (defun prolog-indent-command (&optional whole-exp)
  69.   "Indent current line as Prolog code, or in some cases insert a tab
  70. character.  If prolog-tab-always-indent is non-nil (the default),
  71. always indent current line.  Otherwise, indent the current line only
  72. if point is at the left margin or in the line's indentation; otherwise
  73. insert a tab.  A numeric argument, regardless of its value, means
  74. indent rigidly all the lines of the expression starting after point so
  75. that this line becomes properly indented.  The relative indentation
  76. among the lines of the expression are preserved."
  77.   (interactive "P")
  78.   (if whole-exp
  79.       ;; If arg, always indent this line as Prolog
  80.       ;; and shift remaining lines of expression the same amount.
  81.       (let ((shift-amt (prolog-indent-line))
  82.         beg end)
  83.     (save-excursion
  84.       (if prolog-tab-always-indent
  85.           (beginning-of-line))
  86.       (setq beg (point))
  87.       (forward-term 1)
  88.       (setq end (point))
  89.       (goto-char beg)
  90.       (forward-line 1)
  91.       (setq beg (point)))
  92.     (if (> end beg)
  93.         (indent-code-rigidly beg end shift-amt "%")))
  94.     (if (and (not prolog-tab-always-indent)
  95.          (save-excursion
  96.            (skip-chars-backward " \t")
  97.            (not (bolp))))
  98.     (insert-tab)
  99.       (prolog-indent-line))))
  100.  
  101. (defun prolog-indent-line ()
  102.   "Indent current line as Prolog code.
  103. Return the amount the indentation changed by."
  104.   (interactive)
  105.   (let ((indent (calculate-prolog-indent nil))
  106.     beg shift-amt
  107.     (case-fold-search nil)
  108.     (pos (- (point-max) (point))))
  109.     (beginning-of-line)
  110.     (setq beg (point))
  111.     (cond ((eq indent nil)
  112.        (setq indent (current-indentation)))
  113.       ((eq indent t)
  114.        (setq indent (calculate-prolog-indent-within-comment)))
  115.       (t
  116.        (skip-chars-forward " \t")
  117.        (if (listp indent) (setq indent (car indent)))
  118.        ))
  119.     (skip-chars-forward " \t")
  120.     (setq shift-amt (- indent (current-column)))
  121.     (if (zerop shift-amt)
  122.     (if (> (- (point-max) pos) (point))
  123.         (goto-char (- (point-max) pos)))
  124.       (delete-region beg (point))
  125.       (indent-to indent)
  126.       ;; If initial point was within line's indentation,
  127.       ;; position after the indentation.  Else stay at same point in text.
  128.       (if (> (- (point-max) pos) (point))
  129.       (goto-char (- (point-max) pos))))
  130.     shift-amt))
  131.  
  132.  
  133. (defun calculate-prolog-indent (&optional parse-start)
  134.   "Return appropriate indentation for current line as Prolog code.
  135. In usual case returns an integer: the column to indent to.
  136. Returns nil if line starts inside a string, t if in a comment."
  137.   (interactive)
  138.   (save-excursion
  139.     (beginning-of-line)
  140.     (cond ((head-of-clause-p)
  141.        0)
  142.       ((is-comment)
  143.        t)
  144.       (t (let ((indent-point (point)) 
  145.            (case-fold-search nil)
  146.            state
  147.            containing-sexp)
  148.            (if parse-start
  149.            (goto-char parse-start)
  150.            (beginning-of-clause))
  151.            (while (< (point) indent-point)
  152.          (setq parse-start (point))
  153.          (setq state (parse-partial-sexp (point) indent-point 0))
  154.          (setq containing-sexp (car (cdr state))))
  155.            (cond ((or (nth 3 state) (nth 4 state))
  156.               ;; return nil or t if should not change this line
  157.               (nth 4 state))
  158.              ((null containing-sexp)
  159.               ;; Line is at top level.  It is thus a complete
  160.               ;; predicate, or a continuation of an expression.
  161.               ;; if it is a clause head or fact then leave it
  162.               ;; at column 0. If it is in the clause body,
  163.               ;; then indent by body-predicate-indent.  
  164.               (goto-char indent-point)
  165.               (skip-chars-forward " \t")
  166.               (cond ((and (is-fact)           ;; if fact
  167.                   (check-clause))
  168.                  fact-column)
  169.                 ((point-in-clause-head-p) ;; clause body or head
  170.                  fact-column)
  171. ;;                 head-continuation-indent)
  172. ;;                (t body-predicate-indent)))
  173.                 (t (maybe-indent-body))))
  174.              (t
  175.               ;; line is expression, not statement:
  176.               ;; indent to just after the surrounding open.
  177.               (cond ((setq pos (prolog-inside-term-p))
  178. ;;    What is this ?      (= 1 (car state))) 
  179.                  (get-arg-column pos))
  180.                 (t 
  181.                  ;; Must be an if-then-else
  182.                  ;; If the else part i.e. [;|] then indent
  183.                  ;; to level of current if [(]. Otherwise
  184.                  ;; must indent to level of current if [(]
  185.                  ;; plus if-then-else-indent (user settable)
  186.                  (cond ((prev-line-has-comma)
  187.                     (get-term-column 0))
  188.                    ((string-equal (setq where
  189.                             (after-cond))
  190.                          "no-term")
  191.                     (+ if-then-else-indent 
  192.                        (get-first-term-column)))
  193.                    ((else-part indent-point)
  194.                     (goto-char containing-sexp)
  195.                     (current-column))
  196.                    (t (+ if-then-else-indent 
  197.                      containing-sexp))))
  198.                 )
  199.               )
  200.             )
  201.           )
  202.         )
  203.      )
  204.   )
  205. )
  206. ;;;
  207. ;;;  Are we in the head of a clause ? There mabe no :- or --> on
  208. ;;;  the line.
  209. ;;;
  210. (defun point-in-clause-head-p ()
  211.   (save-excursion
  212.     (cond ((check-prev-line-for-dot)
  213.        t)
  214.       (t nil))))
  215. ;;;
  216. ;;; Are we on a line that contains the head of clause?
  217. ;;; That is does it contain :- or -->
  218. ;;;
  219. (defun head-of-clause-p ()
  220.   (save-excursion
  221.     (end-of-line)
  222.     (let ((limit (point)) 
  223.       (done)
  224.       (in-head))
  225.       (beginning-of-line)
  226.       (while (not done)
  227.     (if (re-search-forward ":-\\|-->" limit t)
  228.         (if (not (prolog-inside-parens-p))
  229.         (progn (setq done t) (setq in-head t)))
  230.       (setq done t)
  231.       (setq in-head nil)
  232.       )
  233.     )
  234.       in-head
  235.       )
  236.     )
  237.   )
  238. ;;;
  239. ;;; prolog-inside-term-p
  240. (defun prolog-inside-term-p ()
  241.   (let ((bracket-pos nil))
  242.     (condition-case ()
  243.     (save-excursion
  244.       (save-restriction
  245.         (narrow-to-region (point)
  246.                   (progn (beginning-of-clause) (point)))
  247.         (goto-char (point-max))
  248.         (cond ((= (char-after 
  249.             (setq bracket-pos (or (scan-lists (point) -1 1) 
  250.                       (point-min))))
  251.             ?\()
  252.            (goto-char bracket-pos)
  253.            (skip-chars-backward "\t")
  254.            (cond ((not (or (= (preceding-char) 32)
  255.                    (= (preceding-char) 9)
  256.                    (= (preceding-char) 10)))
  257.               bracket-pos)
  258.              (t nil)))
  259.           (t nil))))
  260.         (error nil))))
  261. ;;;
  262. ;;; get-arg-column
  263. ;;;
  264. (defun get-arg-column (pos)
  265.   (save-excursion
  266.     (goto-char pos)
  267.     (forward-char)
  268.     (skip-chars-forward " \t")
  269.     (current-column)))
  270. ;;;
  271. ;;; maybe-indent-body
  272. ;;;
  273. (defun maybe-indent-body ()
  274.   (save-excursion
  275.     (goto-valid-line)
  276.     (beginning-of-line)
  277.     (cond ((head-of-clause-p)
  278.        body-predicate-indent)
  279.       (t (skip-chars-forward " \t")
  280.          (current-column)))))
  281. ;;;
  282. ;;; is-fact ?
  283. ;;;
  284. (defun is-fact ()
  285.   (save-excursion
  286.     (end-of-line)
  287.     (let ((pos (point)))
  288.       (beginning-of-line)
  289.       (cond ((re-search-forward "%" pos t)   ; comment present
  290.          (backward-char)
  291.          (skip-chars-backward " \t"))
  292.         (t (end-of-line)
  293.            (skip-chars-backward " \t")))
  294.       (cond ((= (preceding-char) ?.)
  295.          t)
  296.         ( t nil)))))
  297. ;;;
  298. ;;; check-clause
  299. ;;;
  300. (defun check-clause ()
  301.   (cond ((check-prev-line-for-dot)
  302.      t)
  303.     (t nil)))
  304.  
  305. (defun goto-valid-line ()
  306.   (let ((done t)
  307.     (star-comment)
  308.     (line-skip -1))
  309.     (while done
  310.       (cond ((not (eq (forward-line line-skip) 0))
  311.          (setq done nil))
  312.         (t (skip-chars-forward " \t")
  313.            (cond ((and (not (white-space))               ; valid line
  314.                (not (setq star-comment 
  315.                       (in-prolog-/*-*/-comment)))
  316.                (/= (following-char) ?%))
  317.               (setq done nil) t)
  318.              (t (cond ((white-space)                 ; blank line
  319.                    (setq line-skip -1))
  320.                   (star-comment                  ; /*-*/ comment
  321.                    (if (single-line-comment)
  322.                    (if (not (only-comment))
  323.                        (setq done nil) 
  324.                        (setq line-skip -1))
  325.                    (progn
  326.                      (skip-prolog-/*-*/-comment (point-max))
  327.                      (setq line-skip -1))))
  328.                   ((= (following-char) ?%)       ; % comment line
  329.                    (skip-prolog-%-comment (point-max))
  330.                    (setq line-skip 0))))))))))
  331. ;;;
  332. ;;; only-comment
  333. ;;;
  334. (defun only-comment ()
  335.   (save-excursion
  336.     (beginning-of-line)
  337.     (skip-chars-forward " \t")
  338.     (cond ((looking-at "/\\*")
  339.        t)
  340.       ( t nil))))
  341. ;;;
  342. ;;; white-space
  343. ;;;
  344. (defun white-space ()
  345.   (or (= (following-char) 32)
  346.       (= (following-char) 9)
  347.       (= (following-char) 10)))
  348. ;;;
  349. ;;; prolog-/*-*/-comment
  350. ;;;
  351. (defun in-prolog-/*-*/-comment ()
  352.   (save-excursion 
  353.     (end-of-line)
  354.     (let ((limit (point)))
  355.       (beginning-of-line)
  356.       (cond ((re-search-forward "/\\*\\|\\*/" limit t)
  357.          t)
  358.         (t nil)))))
  359. ;;;
  360. ;;; single-line-comment
  361. ;;;
  362. (defun single-line-comment ()
  363.   (save-excursion
  364.     (end-of-line)
  365.     (let ((limit (point))
  366.       line)
  367.       (beginning-of-line)
  368.       (setq line (point))
  369.       (if (and (search-forward "*\/" limit t)
  370.            (search-backward "\/*" line t))
  371.       t
  372.       nil))))
  373. ;;;
  374. ;;; check-prev-line-for-dot
  375. ;;;
  376. (defun check-prev-line-for-dot ()
  377.   (save-excursion
  378.     (goto-valid-line)
  379.     (end-of-line)
  380.     (let ((pos (point)))
  381.       (beginning-of-line)
  382.       (cond ((re-search-forward "%" pos t)   ; comment present
  383.          (backward-char)
  384.          (skip-chars-backward " \t"))
  385.         (t (end-of-line)
  386.            (skip-chars-backward " \t")))
  387.       (cond ((= (preceding-char) ?.)
  388.          t)
  389.         (t nil)))))
  390. ;;;
  391. ;;; Are we in the else (; or | otherwise ->) of an if ?
  392. ;;;
  393. (defun else-part (indent-point)
  394.   (save-excursion
  395.     (goto-char indent-point)
  396.     (skip-chars-forward " \t")
  397.     (cond ((looking-at "[;|)]")
  398.        t)
  399.       ((looking-at "")
  400.        (cond ((prev-line-has-comma)
  401.           nil)
  402.          (t t)))
  403.       ( t nil)
  404.     )
  405.   )
  406. )
  407. ;;;
  408. ;;; prev-line-has-comma
  409. ;;;
  410. (defun prev-line-has-comma ()
  411.   (save-excursion
  412.     (goto-valid-line)
  413.     (maybe-goto-end-of-line)
  414.     (cond ((= (preceding-char) ?,)
  415.        t)
  416.       (t nil))))
  417. ;;;
  418. ;;; get-term-column
  419. ;;;
  420. (defun get-term-column (arg)
  421.   (save-excursion 
  422.     (goto-valid-line)
  423.     (beginning-of-line)
  424.     (while (prolog-inside-term-p)
  425.       (goto-valid-line))
  426.     (skip-chars-forward " \t")
  427.     (cond ((looking-at "[;|]")
  428.        (forward-char)
  429.        (skip-chars-forward " \t"))
  430.       (t (forward-term arg)))
  431.     (current-column)))
  432. ;;;
  433. ;;; get-first-term-column
  434. ;;;
  435. (defun get-first-term-column ()
  436.   (save-excursion
  437.     (goto-valid-line)
  438.     (maybe-goto-end-of-line)
  439.     (let ((limit (point)))
  440.       (beginning-of-line)
  441.       (cond ((re-search-forward "(\\||\\|;" limit t)
  442.          (skip-chars-forward " \t")
  443.          (cond ((looking-at "(")
  444.             (forward-char)
  445.             (skip-chars-forward " \t")))
  446.          (current-column))))))
  447. ;;;
  448. ;;; after-cond
  449. ;;;
  450. (defun after-cond ()
  451.   (save-excursion
  452.     (goto-valid-line)
  453.     (maybe-goto-end-of-line)
  454.     (let ((limit (point)))
  455.       (beginning-of-line)
  456.       (cond ((re-search-forward "->" limit t)
  457.          (skip-chars-forward " \t")
  458.          (cond ((or (white-space)
  459.             (= (following-char) 37))
  460.             "no-term")
  461.            (t "term")))
  462.         (t "no")))))
  463. ;;;
  464. ;;; maybe-goto-end-of-line
  465. ;;;
  466. (defun maybe-goto-end-of-line ()
  467.   (end-of-line)
  468.   (let ((pos (point)))
  469.     (beginning-of-line)
  470.     (cond ((re-search-forward "%" pos t)   ; comment present
  471.        (backward-char)
  472.        (skip-chars-backward " \t"))
  473.       (t (end-of-line)
  474.          (skip-chars-backward " \t")))))
  475. ;;;
  476. ;;; Are we in a comment ? (Either [%+] or between "/*" and "*/")
  477. ;;;
  478. (defun is-comment ()
  479.   (let (found)
  480.     (save-excursion
  481.       (skip-chars-forward " \t")
  482.       (cond ((or (looking-at "%+")
  483.          (looking-at "/\\*")
  484.          (looking-at "\\*/"))
  485.          (setq found t))
  486.         ((re-search-backward "/\\*\\|\\*/" 0 t)
  487.          (cond ((looking-at "/\\*")
  488.             (setq found t))
  489.            (t (setq found nil))))
  490.         (t (setq found nil))
  491.       )
  492.     )
  493.     found
  494.   )
  495. )
  496. ;;;
  497. ;;; beginning-of-clause
  498. ;;;
  499. (defun beginning-of-clause (&optional arg)
  500.   "Move backward to next beginning-of-clause.
  501. With argument, do this that many times.
  502. Returns t unless search stops due to end of buffer."
  503.   (interactive "p")
  504.   (and arg (< arg 0) (forward-char 1))
  505.   (let ((clause-point (point)) (not-done t) (command-point (point)))
  506.     (while (and not-done (not (bobp)))
  507.       (if (and arg (< arg 0))
  508.       (skip-chars-forward " \t\n")
  509.       (skip-chars-backward " \t\n"))
  510.       (if (re-search-backward "^\\S-" nil 'move (or arg 1))
  511.       (progn
  512.         (if (white-space)
  513.         (re-search-backward "^\\S-" nil 'move 1))
  514.         (if (= (following-char) ?%)
  515.         (skip-prolog-%-comment clause-point)
  516.         (if (is-comment)
  517.             (setq not-done 
  518.               (not (skip-prolog-/*-*/-comment clause-point)))
  519.             (if (not (white-space))
  520.             (setq not-done nil))))))
  521.       (setq clause-point (point)))
  522.     )
  523.   )
  524.  
  525.  
  526. (defun calculate-prolog-indent-within-comment ()
  527.   "Return the indentation amount for line, assuming that
  528. the current line is to be regarded as part of a block comment."
  529.   (let (end star-start)
  530.     (save-excursion
  531.       (beginning-of-line)
  532.       (skip-chars-forward " \t")
  533.       (cond 
  534.        ((looking-at "%%%")
  535.     (current-column))
  536.        ((looking-at "%%")
  537.     (current-column))
  538.        ((looking-at "\\*/")
  539.     (current-column))
  540.        ((looking-at "/\\*")
  541.     0)
  542. ;;    (let ((tem (calculate-prolog-indent)))
  543. ;;      (if (listp tem) (car tem) tem)))
  544.        ((= (following-char) ?%) 
  545.     (skip-chars-backward " \t")
  546.     (max (if (bolp) 0 (1+ (current-column)))
  547.          comment-column))
  548.        (t
  549.      (setq star-start (= (following-char) ?\*))
  550.      (skip-chars-backward " \t\n")
  551.      (setq end (point))
  552.      (beginning-of-line)
  553.      (skip-chars-forward " \t")
  554.      (and (re-search-forward "/\\*[ \t]*" end t)
  555.           star-start
  556.           (goto-char (1+ (match-beginning 0))))
  557.      (current-column)
  558.      )
  559.     )
  560.       )
  561.     )
  562.   )
  563.  
  564. (defun prolog-backward-to-noncomment (lim)
  565.   (let (opoint stop)
  566.     (while (not stop)
  567.       (skip-chars-backward " \t\n\f" lim)
  568.       (setq opoint (point))
  569.       (if (and (>= (point) (+ 2 lim))
  570.            (save-excursion
  571.          (forward-char -2)
  572.          (looking-at "\\*/")))
  573.       (search-backward "/*" lim 'move)
  574.     (beginning-of-line)
  575.     (skip-chars-forward " \t")
  576.     (if (looking-at "#")
  577.         (setq stop (<= (point) lim))
  578.       (setq stop t)
  579.       (goto-char opoint))))))   
  580.  
  581. (defun prolog-indent-clause ()
  582.   "Indent each line of the prolog clause"
  583.   (interactive)
  584.   (end-of-clause)
  585.   (setq end (point))
  586.   (beginning-of-clause)
  587.   (prolog-indent-lines end))
  588.  
  589. (defun prolog-indent-lines (end)
  590.   (cond 
  591.     ((> (point) end) t)
  592.     (t (prolog-indent-line)
  593.        (next-line 1)
  594.        (prolog-indent-lines end))))
  595.